home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / nrpas13.zip / IRBIT1.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-29  |  2KB  |  66 lines
  1. FUNCTION irbit1(VAR iseed: integer): integer;
  2. (* This routine runs much faster if you can perform bitwise logical operations
  3. on integers.  For example, here is a TURBO Pascal version:
  4. CONST
  5.    ib1=1; ib3=4; ib5=16; ib14=8192;
  6. VAR
  7.    newbit: boolean;
  8. BEGIN
  9.    newbit := (iseed AND ib14) <> 0;
  10.    IF ((iseed AND ib5) <> 0) THEN newbit :=  NOT newbit;
  11.    IF ((iseed AND ib3) <> 0) THEN newbit :=  NOT newbit;
  12.    IF ((iseed AND ib1) <> 0) THEN newbit :=  NOT newbit;
  13.    iseed := iseed SHL 1;
  14.    IF (newbit) THEN BEGIN
  15.       irbit1 := 1; iseed := iseed OR ib1
  16.    END ELSE BEGIN
  17.       irbit1 := 0; iseed := iseed AND (NOT ib1)
  18.    END
  19. END; *)
  20. (* Here is the slower version for other Pascal systems: *)
  21. CONST
  22.    ib1=1;
  23.    ib3=4;
  24.    ib5=16;
  25.    ib14=8192;    (* Values chosen not to overflow 2-byte integers *)
  26. VAR
  27.    mask: integer;
  28.    newbit: boolean;
  29. FUNCTION iand(i1,i2: integer): integer;
  30.    VAR
  31.       i: integer;
  32.    BEGIN
  33.       IF ((i1=0) OR (i2=0)) THEN iand := 0
  34.       ELSE BEGIN
  35.          i := ord(odd(i1) AND odd(i2));
  36.          i1 := i1 DIV 2; i2 := i2 DIV 2;
  37.          iand := 2*iand(i1,i2) + i
  38.       END
  39.    END;
  40. FUNCTION inot(ib: integer): integer;
  41.    BEGIN inot := maxint-ib END;
  42. FUNCTION ior(i1,i2: integer): integer;
  43.    VAR
  44.       i: integer;
  45.    BEGIN
  46.       IF ((i1=0) AND (i2=0)) THEN ior := 0
  47.       ELSE BEGIN
  48.          i := ord(odd(i1) OR odd(i2));
  49.          i1 := i1 DIV 2; i2 := i2 DIV 2;
  50.          ior := 2*ior(i1,i2) + i
  51.       END
  52.    END;
  53. BEGIN
  54.    mask := maxint DIV 2;
  55.    newbit := iand(iseed,ib14) <> 0;
  56.    IF (iand(iseed,ib5) <> 0) THEN newbit :=  NOT newbit;
  57.    IF (iand(iseed,ib3) <> 0) THEN newbit :=  NOT newbit;
  58.    IF (iand(iseed,ib1) <> 0) THEN newbit :=  NOT newbit;
  59.    irbit1 := 0;
  60.    iseed := iand(2*iand(mask,iseed),inot(ib1));
  61.    IF (newbit) THEN BEGIN
  62.       irbit1 := 1;
  63.       iseed := ior(iseed,ib1);
  64.    END
  65. END;
  66.